home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 1997 #1 / Amiga Plus CD - 1997 - No. 01.iso / pd / programmierung / oberonv4 / demos / dhrystone.mod (.txt) < prev    next >
Oberon Text  |  1994-06-30  |  8KB  |  255 lines
  1. Syntax10.Scn.Fnt
  2. MODULE Dhrystone;
  3.   (* Ada:      Reinhold P. Weicker, 15-Apr-84
  4.      Modula-2: Werner Heiz, 27-Sep-87 
  5.   Oberon: B. Heeb, 15-2-89
  6.   Sparc-Oberon: J. Templ 28.1.91, Version 2.1 *)
  7.   IMPORT Texts, Input, Oberon;
  8.   CONST
  9.     Ident1 = 0; Ident2 = 1; Ident3 = 2; Ident4 = 3; Ident5 = 4;
  10.     NumberOfRuns = 20000;
  11.   TYPE
  12.   INTEGER = LONGINT;
  13.     Enumeration      = INTEGER;
  14.     OneToThirty      = INTEGER;
  15.     OneToFifty       = INTEGER;
  16.     CapitalLetter    = CHAR;
  17.     String30         = ARRAY 31 OF CHAR;
  18.     Array1DimInteger = ARRAY 50 OF INTEGER;
  19.     Array2DimInteger = ARRAY 50, 50 OF INTEGER;
  20.     RecordPointer    = POINTER TO RecordType;
  21.     RecordType       = RECORD
  22.                          PointerComp: RecordPointer;
  23.                          Discr: Enumeration;
  24.                          EnumComp: Enumeration;
  25.                          IntComp: OneToFifty;
  26.                          StringComp: String30;
  27.                          CharComp1, CharComp2: CHAR;
  28.                        END;
  29.   VAR
  30.     IntGlob: INTEGER;
  31.     BoolGlob: BOOLEAN;
  32.     CharGlob1,
  33.     CharGlob2: CHAR;
  34.     ArrayGlob1: Array1DimInteger;
  35.     ArrayGlob2: Array2DimInteger;
  36.     PointerGlob,
  37.     PointerGlobNext: RecordPointer;
  38.     time, num: LONGINT;
  39.   W: Texts.Writer;
  40.   PROCEDURE Func1(CharParIn1, CharParIn2: CapitalLetter): Enumeration;
  41.     VAR CharLoc1, CharLoc2: CapitalLetter;
  42.   BEGIN
  43.     CharLoc1 := CharParIn1;
  44.     CharLoc2 := CharLoc1;
  45.     IF CharLoc2 # CharParIn2 THEN
  46.       RETURN Ident1;
  47.     ELSE
  48.       RETURN Ident2;
  49.     END;
  50.   END Func1;
  51.   PROCEDURE Func2(VAR StringParIn1, StringParIn2: String30): BOOLEAN;
  52.     VAR IntLoc: OneToFifty; CharLoc: CapitalLetter;
  53.   BEGIN
  54.     IntLoc := 2;
  55.     WHILE IntLoc <= 2 DO
  56.       IF Func1(StringParIn1[IntLoc], StringParIn2[IntLoc+1]) = Ident1 THEN
  57.         CharLoc := "A";
  58.         INC(IntLoc);
  59.       END;
  60.     END;
  61.     IF (CharLoc >= "W") & (CharLoc < "Z") THEN
  62.       IntLoc := 7;
  63.     END;
  64.     IF CharLoc = "X" THEN
  65.       RETURN TRUE;
  66.     ELSE
  67.       IF StringParIn1 > StringParIn2 THEN
  68.         IntLoc := IntLoc + 7;
  69.         RETURN TRUE;
  70.       ELSE
  71.         RETURN FALSE;
  72.       END;
  73.     END;
  74.   END Func2;
  75.   PROCEDURE Func3(EnumParIn: Enumeration): BOOLEAN;
  76.     VAR EnumLoc: Enumeration;
  77.   BEGIN
  78.     EnumLoc := EnumParIn;
  79.     RETURN EnumLoc = Ident3
  80.   END Func3;
  81.   PROCEDURE Proc6(EnumParIn: Enumeration; VAR EnumParOut: Enumeration);
  82.   BEGIN
  83.     EnumParOut := EnumParIn;
  84.     IF ~ Func3(EnumParIn) THEN
  85.       EnumParOut := Ident4;
  86.     END;
  87.     CASE EnumParIn OF
  88.     | Ident1: EnumParOut := Ident1;
  89.     | Ident2: IF IntGlob > 100 THEN
  90.                 EnumParOut := Ident1;
  91.               ELSE
  92.                 EnumParOut := Ident4;
  93.               END;
  94.     | Ident3: EnumParOut := Ident2;
  95.     | Ident4: ;
  96.     | Ident5: EnumParOut := Ident3;
  97.     END;
  98.   END Proc6;
  99.   PROCEDURE Proc7(IntParIn1, IntParIn2: OneToFifty; VAR IntParOut: OneToFifty);
  100.     VAR IntLoc: OneToFifty;
  101.   BEGIN
  102.     IntLoc := IntParIn1 + 2;
  103.     IntParOut := IntParIn2 + IntLoc;
  104.   END Proc7;
  105.   PROCEDURE Proc3(VAR PointerParOut: RecordPointer);
  106.   BEGIN
  107.     IF PointerGlob # NIL THEN
  108.       PointerParOut := PointerGlob^.PointerComp;
  109.     ELSE
  110.       IntGlob := 100;
  111.     END;
  112.     Proc7(10, IntGlob, PointerGlob^.IntComp);
  113.   END Proc3;
  114.   PROCEDURE Proc1(PointerParIn: RecordPointer);
  115.     VAR p: RecordPointer;
  116.   BEGIN
  117.     PointerParIn^.PointerComp^ := PointerGlob^;
  118.     p := PointerParIn.PointerComp;
  119.     PointerParIn.IntComp := 5;
  120.     p.IntComp := PointerParIn.IntComp;
  121.     p.PointerComp := PointerParIn.PointerComp;
  122.     Proc3(p.PointerComp);
  123.     IF p.Discr = Ident1 THEN
  124.       p.IntComp := 6;
  125.       Proc6(PointerParIn.EnumComp, p.EnumComp);
  126.       p.PointerComp := PointerGlob^.PointerComp;
  127.       Proc7(p.IntComp, 10, p.IntComp);
  128.     ELSE
  129.       PointerParIn^ := PointerParIn.PointerComp^;
  130.     END
  131.   END Proc1;
  132.   PROCEDURE Proc2(VAR IntParInOut: OneToFifty);
  133.     VAR IntLoc: OneToFifty; EnumLoc: Enumeration;
  134.   BEGIN
  135.     IntLoc := IntParInOut + 10;
  136.     REPEAT
  137.       IF CharGlob1 = "A" THEN
  138.         DEC(IntLoc); IntParInOut := IntLoc - IntGlob;
  139.         EnumLoc := Ident1;
  140.       END;
  141.     UNTIL EnumLoc = Ident1;
  142.   END Proc2;
  143.   PROCEDURE Proc4;
  144.     VAR BoolLoc: BOOLEAN;
  145.   BEGIN
  146.     BoolLoc := CharGlob1 = "A";
  147.     BoolLoc := BoolLoc OR BoolGlob;
  148.     CharGlob2 := "B";
  149.   END Proc4;
  150.   PROCEDURE Proc5;
  151.   BEGIN
  152.     CharGlob1 := "A"; BoolGlob := FALSE
  153.   END Proc5;
  154.   PROCEDURE Proc8(VAR ArrayParInOut1: Array1DimInteger;
  155.                   VAR ArrayParInOut2: Array2DimInteger;
  156.                   IntParIn1, IntParIn2: INTEGER);
  157.     VAR IntLoc: OneToFifty; IntIndex: INTEGER;
  158.   BEGIN
  159.     IntLoc := IntParIn1 + 5;
  160.     ArrayParInOut1[IntLoc] := IntParIn2;
  161.     ArrayParInOut1[IntLoc+1] := ArrayParInOut1[IntLoc];
  162.     ArrayParInOut1[IntLoc+30] := IntLoc;
  163.     IntIndex := IntLoc;
  164.     WHILE IntIndex <= IntLoc+1 DO
  165.       ArrayParInOut2[IntLoc, IntIndex] := IntLoc; INC(IntIndex)
  166.     END;
  167.     INC(ArrayParInOut2[IntLoc, IntLoc-1]);
  168.     ArrayParInOut2[IntLoc+20, IntLoc] := ArrayParInOut1[IntLoc];
  169.     IntGlob := 5;
  170.   END Proc8;
  171.   PROCEDURE Proc0;
  172.     VAR
  173.       IntLoc1, IntLoc2, IntLoc3: OneToFifty;
  174.       CharLoc: CHAR;
  175.       EnumLoc: Enumeration;
  176.       StringLoc1, StringLoc2: String30;
  177.       CharIndex: INTEGER;
  178.   BEGIN
  179.     StringLoc1 := "DHRYSTONE PROGRAM, 1'ST STRING";
  180.     ArrayGlob2[8, 7] := 10;  (*was missing in published program*)
  181.     num := 0; time := Oberon.Time();
  182.     WHILE num < NumberOfRuns DO
  183.       Proc5;
  184.       Proc4;
  185.       IntLoc1 := 2;
  186.       IntLoc2 := 3;
  187.       StringLoc2 := "DHRYSTONE PROGRAM, 2'ND STRING";
  188.       EnumLoc := Ident2;
  189.       BoolGlob := ~ Func2(StringLoc1, StringLoc2);
  190.       WHILE IntLoc1 < IntLoc2 DO
  191.         IntLoc3 := 5 * IntLoc1 - IntLoc2;
  192.         Proc7(IntLoc1, IntLoc2, IntLoc3);
  193.         INC(IntLoc1);
  194.       END;
  195.       Proc8(ArrayGlob1, ArrayGlob2, IntLoc1, IntLoc3);
  196.       Proc1(PointerGlob);
  197.       CharIndex := ORD("A");
  198.       WHILE CharIndex <= ORD(CharGlob2) DO
  199.         IF EnumLoc = Func1(CHR(CharIndex), "C") THEN
  200.           Proc6(Ident1, EnumLoc);
  201.         END;
  202.         INC(CharIndex)
  203.       END;
  204.       IntLoc2 := IntLoc2 * IntLoc1;
  205.       IntLoc1 := IntLoc2 DIV IntLoc3;
  206.       IntLoc2 := 7 * (IntLoc2 - IntLoc3) - IntLoc1;
  207.       Proc2(IntLoc1);
  208.       INC(num)
  209.     END ;
  210.     time := Oberon.Time() - time;
  211.     IF time < 2000 THEN Texts.WriteString(W, "too short, use more runs ")
  212.     ELSIF (IntGlob = 5) &
  213.       BoolGlob &
  214.       (CharGlob1 = "A") &
  215.       (CharGlob2 = "B") &
  216.     (ArrayGlob1[8] = 7) &
  217.     (ArrayGlob2[8, 7] MOD 32768 = (num + 10) MOD 32768) &
  218.     (PointerGlob.Discr = 0) &
  219.     (PointerGlob.EnumComp = 2) &
  220.     (PointerGlob.IntComp = 17) &
  221.     (PointerGlob.StringComp = "DHRYSTONE PROGRAM, SOME STRING") &
  222.     (PointerGlobNext.Discr = 0) &
  223.     (PointerGlobNext.EnumComp = 1) &
  224.     (PointerGlobNext.IntComp = 18) &
  225.     (PointerGlobNext.StringComp = "DHRYSTONE PROGRAM, SOME STRING") &
  226.     (IntLoc1 = 5) &
  227.     (IntLoc2 = 13) &
  228.     (IntLoc3  = 7) &
  229.     (EnumLoc = 1) &
  230.     (StringLoc1 = "DHRYSTONE PROGRAM, 1'ST STRING") &
  231.     (StringLoc2 = "DHRYSTONE PROGRAM, 2'ND STRING")
  232.     THEN Texts.WriteString(W, "passed  ");
  233.   ELSE Texts.WriteString(W, "failed  ")
  234.   END
  235.   END Proc0;
  236.   PROCEDURE Do*;
  237.   BEGIN
  238.     Texts.WriteString(W, "Dhrystone:  "); Texts.Append(Oberon.Log, W.buf);
  239.     Proc0;
  240.     Texts.WriteInt(W, (num*1000) DIV time, 10);
  241.     Texts.WriteString(W, " / sec");
  242.     Texts.WriteLn(W);
  243.     Texts.Append(Oberon.Log, W.buf);
  244.   END Do;
  245. BEGIN
  246.   Texts.OpenWriter(W);
  247.     NEW(PointerGlobNext);
  248.     NEW(PointerGlob);
  249.     PointerGlob.PointerComp := PointerGlobNext;
  250.     PointerGlob.Discr := Ident1;
  251.     PointerGlob.EnumComp := Ident3;
  252.     PointerGlob.IntComp := 40;
  253.     PointerGlob.StringComp := "DHRYSTONE PROGRAM, SOME STRING";
  254. END Dhrystone.Do
  255.